home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / PLAYVOC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-28  |  5.0 KB  |  118 lines
  1. {$M 16384, 0, 333000} {Save some of the heap for the DOS shell}
  2. program PlayVOC;
  3.     uses
  4.         CRT,
  5.         DOS,
  6.         SBVox;
  7.     const
  8.         DefaultVOC    = 'FROGS.VOC';
  9.          {Put the name of the VOC file to play here}
  10.          {or pass it as a parameter to the program}
  11.         InterruptNum  = 5;     {/ YOU WILL PROBABLY HAVE}
  12.         BaseIOAddress = $220;  {\ TO CHANGE THESE CONSTS}
  13. {$IFNDEF LinkDriver}
  14.         DriverPath    = ''; {'' if the driver is in the current directory}
  15. {$ENDIF}
  16.     var
  17.         VOCFileName : string;
  18.         SoundSize   : LongInt;
  19.         Header      : PVOCHeader;
  20.         Result      : integer;
  21.         Sound       : PSound;
  22.         Chr         : char;
  23.         VersionWord : word;
  24.     procedure WriteInstructions;
  25.         begin
  26.             writeln('Begining output of sound file');
  27.             writeln('Press <P> to pause');
  28.             writeln('Press <C> to continue');
  29.             writeln('Press <S> to stop');
  30.             writeln('Press <B> to stop at end of next repeat loop (If repeating)');
  31.             writeln('Press <N> to stop immediately');
  32.             writeln('Press <D> to shell to DOS');
  33.         end;
  34.     begin
  35.         writeln; writeln;
  36.  
  37.         if ParamCount = 0
  38.             then VOCFileName := DefaultVOC
  39.             else VOCFileName := ParamStr(1);
  40.  
  41. {$IFNDEF LinkDriver}
  42.         Result := LoadDriver(DriverPath + 'CT-VOICE.DRV');   writeln('Attempting to install Sound Blaster driver:   ');
  43. {$ELSE}
  44.         writeln('Sound Blaster driver linked in'); Result := LoadDrvSuccess;
  45. {$ENDIF}
  46.         case Result
  47.             of
  48.                 LoadDrvSuccess:   writeln('Sound Blaster driver loaded successfully');
  49.                 LoadDrvIOerror:   writeln('IO error loading Sound Blaster driver');
  50.                 LoadDrvNoMemory:  writeln('Not enough memory to load Sound Blaster driver');
  51.                 LoadDrvBadDriver: writeln('Sound Blaster driver is corrupted (Well at least the header is)');
  52.             end;
  53.         if Result <> LoadDrvSuccess then Halt(255);
  54.         VersionWord := GetDriverVersion;
  55.         writeln('Sound Blaster Driver Version: ', Hi(VersionWord), '.', Lo(VersionWord));
  56.         SetInterrupt(InterruptNum);       writeln('Interrupt Number set to ', InterruptNum);
  57.         SetBaseIOAddress(BaseIOAddress);  writeln('Base IO address set');
  58.         Result := InitSB; write('Attempting to initialize Sound Blaster:   ');
  59.         case Result
  60.             of
  61.                 SBInitSuccess:                writeln('SB Initialized Correctly');
  62.                 SBInitSoundCardFailure:       writeln('Sound Card Failure');
  63.                 SBInitIOFailure:              writeln('IO Failure');
  64.                 SBInitDMAorInterruptFailure:  writeln('DMA or Interrupt Failure');
  65.             end;
  66.         if Result <> 0 then Halt(255);
  67.         InitStatusWord;
  68.  
  69.         Header := nil; Sound := nil;
  70.         SoundSize := LoadVOCfile(VOCFileName, Header, Sound);  writeln('Sound file loaded');
  71.         if SoundSize = 0
  72.             then
  73.                 begin
  74.                     writeln('Error loading VOC file');
  75.                     Halt;
  76.                 end;
  77.  
  78.         TurnSpeakerOn;
  79.         WriteInstructions;
  80.         PlaySound(Sound);
  81.         repeat
  82.             if KeyPressed
  83.                 then
  84.                     begin
  85.                         Chr := UpCase(ReadKey);
  86.                         case Chr
  87.                             of
  88.                                 'P': PauseSound;
  89.                                 'C': ContinueSound;
  90.                                 'S': StopSound;
  91.                                 'B': BreakLoop(BreakLoopAtEnd);
  92.                                 'N': BreakLoop(BreakLoopNow);
  93.                                 'D':
  94.                                     begin
  95.                                         SwapVectors;
  96.                                         Exec(GetEnv('COMSPEC'), '');
  97.                                         if DOSError <> 0
  98.                                             then
  99.                                                 begin
  100.                                                     writeln('Error running COMMAND.COM.   Probably not enough memory');
  101.                                                     Halt;
  102.                                                 end;
  103.                                         SwapVectors;
  104.                                         WriteInstructions;
  105.                                     end;
  106.                             end;
  107.                     end;
  108.         until StatusWord = SoundCompleted; writeln('Sound output completed');
  109.         TurnSpeakerOff;                    writeln('Speaker turned off');
  110.  
  111.         Dispose(Header);
  112.         FreeSoundBuffer(Sound, SoundSize); writeln('Sound buffer deallocated');
  113. {$IFDEF LinkDriver}
  114.         ShutDownDriver;                    writeln('Sound Blaster driver unloaded');
  115. {$ELSE}
  116.         UnloadDriver;                      writeln('Sound Blaster driver uninstalled');
  117. {$ENDIF}
  118.     end.